Business & Presentations/Business and Presentations - Volume 1 (1995)(Sideface)(NL).iso/hputils/dprint/dprint.pas

Pascal/Delphi Source File | 1988-04-10 | 5KB | 200 lines

Program DoublePrint;
{This is a program to print full 66 line pages on a laserjet back to back.
 This cuts down the pages to half and the allows you to have a nicer printout.
 This program is not very efficent and I appologize for the lack of elegance
 but it is a prelude of things to come.

 Writen by
 Kearn Kelley March 5th, 1988}
uses
  printer;
const
  esc = #27;
var
  X, Count, FFPos, LineCount, Page : integer;
  Enter : char;
  Line : string[132];
  Filename : string[80];
  Filvar : text;
  Ioerr : boolean;
procedure Write_Char(Charactor : char); {If an error occurs with the printer}
begin                                   {Turbo will generate a run-time error}
  {$I-}                                 {and abort so this procedure does}
  Write(lst,Charactor);                 {it's own error checking}
  if ioresult <>0 then
    begin
      writeln('Printer error. Please fix the printer and Press');
      write('enter to continue or Cntl-C to Abort');
      read(enter);
      Write_Char(Charactor);
    end;
  {$I+}
end;
procedure Wrln(Lines : string);
begin
  for Count := 1 to length(Lines) do Write_Char(Lines[Count]);
  Write_Char(#13);
end;
procedure Wr(Lines : string);
begin
  for Count := 1 to length(Lines) do Write_Char(Lines[Count]);
end;
procedure IOcheck;
{ Check for i/o error and print message if so}
var
  Iocode : integer;
  Ch : char;
begin
  Iocode := ioresult;
  Ioerr := (Iocode<>0);
  if Ioerr then begin
    case iocode of
      $02   : writeln('File does not exist');
    else
      write('Unknown I/O error upon opening file');
      write('Error Code ',iocode:3)
    end;
  end
end;
procedure Get_File;
{opens the filename specified and readies it for input}
begin
  filename := paramstr(1);
  if filename <> '' then
    begin
      {$i-}
      assign(filvar,filename);
      reset(filvar);
      iocheck;
    end;
  if (filename = '') or (ioerr = true) then
  repeat
  begin
    write('File you wish to Print ');
    readln(filename);
    {$i-}
    assign(filvar,filename);
    reset(filvar);
    iocheck;
  end;
  until (ioerr = false);
  {$i+}
end;
begin
  get_file;
  line := esc + '&l7.27c67F';         {This is the only Laserjet specific}
  wr(line);                           {code.  This code tells the Laser to}
  line := esc + '&k3G';               {use 7.27 lines per inch, 67 lines}
  wr(line);                           {per page, to print a cr+lf for every}
  linecount := 1;                     {cr, and a cr with every ff}
  page := 1;
  repeat
    line := '';
    readln(filvar,line);
    FFPos := Pos(#12,line);
    if FFPos <> 0 then
      begin
        if FFPos = length(line) then
          begin
            if page mod 2 = 1 then
              begin
                wr(line);
                Page := Page +1;
                Linecount := 2;
              end
            else
              begin
                line := '';
                wrln(line);
                Page := Page +1;
                Linecount := 2;
              end;
          end
        else
          begin
            if page mod 2 = 1 then
              begin
                wr(copy(line,1,ffpos));
                Page := Page + 1;
                Linecount := 2;
              end
            else
              begin
                wrln(copy(line,ffpos+1,length(line)));
                Page := Page + 1;
                Linecount := 2;
              end;
          end;
      end
    else
      begin
        if page mod 2 = 1 then wrln(line);
        linecount := linecount + 1;
        if linecount = 67 then
          begin
            if page mod 2 = 1 then wr(#12);
            linecount := 1;
            Page := Page + 1;
          end;
      end;
  until eof(filvar);
  if (page mod 2 = 1) and (linecount <> 1) then wr(#12);
  write('Press the enter key when ready');
  read(enter);
  reset(filvar);
  linecount := 1;
  page := 1;
  repeat
    line := '';
    readln(filvar,line);
    FFPos := Pos(#12,line);
    if FFPos <> 0 then
      begin
        if FFPos = length(line) then
          begin
            if page mod 2 = 0 then
              begin
                wr(line);
                Page := Page +1;
                Linecount := 2;
              end
            else
              begin
                line := '';
                wrln(line);
                Page := Page +1;
                Linecount := 2;
              end;
          end
        else
          begin
            if page mod 2 = 0 then
              begin
                wr(copy(line,1,ffpos));
                Page := Page + 1;
                Linecount := 2;
              end
            else
              begin
                wrln(copy(line,ffpos+1,length(line)));
                Page := Page + 1;
                Linecount := 2;
              end;
          end;
      end
    else
      begin
        if page mod 2 = 0 then wrln(line);
        linecount := linecount + 1;
        if linecount = 67 then
          begin
            if page mod 2 = 0 then wr(#12);
            linecount := 1;
            Page := Page + 1;
          end;
      end;
  until eof(filvar);
if (page mod 2 = 0) and (linecount <> 1) then wr(#12);
line := esc + '&k0G';
wr(line);
end.